//
// Created by root on 5/30/17.
//

#include "../basic/operator.h"

Cell* make_complex(Scheme *sc, Cell* a, Cell* b) {
    Cell* complex = cons(sc, a, b);
    complex->_type = COMPLEX_TYPE;
    return complex;
}

Cell* op_make_complex(Scheme *sc) {
    Cell* x = first(sc->args);
    Cell* y = second(sc->args);
    TYPE_CHECK(sc, x, REAL_TYPE);
    TYPE_CHECK(sc, y, REAL_TYPE);
    sc->returnValue = make_complex(sc, x, y);
    return pop_callstack(sc);
}

Cell* op_complex_real(Scheme *sc) {
    Cell* x = first(sc->args);
    TYPE_CHECK(sc, x, COMPLEX_TYPE);
    sc->returnValue = car(x);
    return pop_callstack(sc);
}

Cell* op_complex_imag(Scheme *sc) {
    Cell* x = first(sc->args);
    TYPE_CHECK(sc, x, COMPLEX_TYPE);
    sc->returnValue = cdr(x);
    return pop_callstack(sc);
}

Cell* complex_add(Scheme *sc, Cell* x, Cell* y) {
    TYPE_CHECK_FOR_CELL(sc, x, COMPLEX_TYPE);
    TYPE_CHECK_FOR_CELL(sc, y, COMPLEX_TYPE);
    Cell* a = car(x);
    Cell* b = cdr(x);
    Cell* c = car(y);
    Cell* d = cdr(y);
    Cell* x1 = real_add(sc, a, c);
    Cell* x2 = real_add(sc, b, d);
    if (is_zero_number(x2)) {
        return x1;
    } else {
        return make_complex(sc, x1, x2);
    }
}

Cell* complex_mul(Scheme *sc, Cell* x, Cell* y) {
    TYPE_CHECK_FOR_CELL(sc, x, COMPLEX_TYPE);
    TYPE_CHECK_FOR_CELL(sc, y, COMPLEX_TYPE);
    Cell* a = car(x);
    Cell* b = cdr(x);
    Cell* c = car(y);
    Cell* d = cdr(y);
    Cell* x1 = real_mul(sc, a, c);
    Cell* x2 = real_mul(sc, b, d);
    Cell* x3 = real_sub(sc, x1, x2);
    Cell* x4 = real_mul(sc, a, d);
    Cell* x5 = real_mul(sc, b, c);
    Cell* x6 = real_add(sc, x4, x5);
    if (is_zero_number(x6)) {
        return x3;
    } else {
        return make_complex(sc, x3, x6);
    }
}

Cell* complex_sub(Scheme *sc, Cell* x, Cell* y) {
    TYPE_CHECK_FOR_CELL(sc, x, COMPLEX_TYPE);
    TYPE_CHECK_FOR_CELL(sc, y, COMPLEX_TYPE);
    Cell* a = car(x);
    Cell* b = cdr(x);
    Cell* c = car(y);
    Cell* d = cdr(y);
    Cell* x1 = real_sub(sc, a, c);
    Cell* x2 = real_sub(sc, b, d);
    if (is_zero_number(x2)) {
        return x1;
    } else {
        return make_complex(sc, x1, x2);
    }
}

Cell* complex_div(Scheme *sc, Cell* x, Cell* y) {
    TYPE_CHECK_FOR_CELL(sc, x, COMPLEX_TYPE);
    TYPE_CHECK_FOR_CELL(sc, y, COMPLEX_TYPE);
    if (is_zero_number(y)) {
        return make_default_exception(sc, "DIVISION_BY_ZERO", "/: division by zero.");
    }
    Cell* a = car(x);
    Cell* b = cdr(x);
    Cell* c = car(y);
    Cell* d = cdr(y);
    Cell* d1 = real_mul(sc, c, c);
    Cell* d2 = real_mul(sc, d, d);
    Cell* denom = real_add(sc, d1, d2);
    Cell* x1 = real_mul(sc, a, c);
    Cell* x2 = real_mul(sc, b, d);
    Cell* x3 = real_add(sc, x1, x2);
    Cell* x4 = real_mul(sc, b, c);
    Cell* x5 = real_mul(sc, a, d);
    Cell* x6 = real_sub(sc, x4, x5);
    Cell* x7 = real_div(sc, x3, denom);
    Cell* x8 = real_div(sc, x6, denom);
    if (is_zero_number(x8)) {
        return x7;
    } else {
        return make_complex(sc, x7, x8);
    }
}

void init_complex_operators(Scheme *sc) {
    ADD_OPERATOR(sc, "make-complex", make_complex);
    ADD_OPERATOR(sc, "real", complex_real);
    ADD_OPERATOR(sc, "imag", complex_imag);
}
